home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / ShareMailGiftware / AmigaTalk / general / Object.st < prev    next >
Encoding:
Text File  |  2002-10-27  |  7.7 KB  |  276 lines
  1. "-----------------------------------------------------------------"
  2. " Object Class is the Root of all other Classes in AmigaTalk.     "
  3. " The perform: methods are NOT part of the original Little        "
  4. " Smalltalk code.  They might be moved sometime in the future.    "
  5. "-----------------------------------------------------------------"
  6.  
  7. Class Object
  8. [
  9.     identityHash                 " Added on 02-Apr-2002 "   
  10.       ^ <primitive 5 self>
  11. |       
  12.     == anObject
  13.       ^ <primitive 7 self anObject >
  14. |
  15.     ~~ x
  16.       ^ (self == x) not
  17. |
  18.     = x
  19.       ^ (self == x)              "Is the receiver equal to x??"
  20. |
  21.     ~= x
  22.       ^ (self = x) not           "Is the receiver NOT equal to x??"
  23. |
  24.     asString
  25.       ^ <primitive 152 (self class)> "Avoid recursion!"
  26.       "^ self class printString" "<<--Infinite recursive method."
  27. |
  28.     asSymbol
  29.       ^ self asString asSymbol   "Return the class a Symbol."
  30. |
  31.     yourself                     "Synonym for self."
  32.       ^ self
  33. |
  34.     class
  35.       ^ <primitive 1 self>
  36. |
  37.     copy
  38.       ^ self shallowCopy
  39. |
  40.     deepCopy  ! size newobj !
  41.       size <- <primitive 4 self>.
  42.  
  43.       (size < 0) 
  44.           ifTrue: [^ self] "if special just copy object"
  45.          ifFalse: [ newobj <- self class new.
  46.  
  47.                     (1 to: size) do: [:i |
  48.                       <primitive 112 newobj i ( <primitive 111 self i > copy ) > ].
  49.                     ^ newobj 
  50.                   ]
  51. |
  52.     first
  53.       ^ self
  54. |
  55.     do: aBlock     ! item !
  56.       item <- self first.
  57.  
  58.       ^ [item notNil] 
  59.           whileTrue: [ aBlock value: item.  
  60.                        item <- self next
  61.                      ]
  62. |
  63.     do: aBlock without: anObject ! item !  "Added on 20-Jun-2001 (JTS)"
  64.       (anObject == nil)
  65.          ifFalse: [ item <- self first.
  66.  
  67.                     ^ [item notNil] 
  68.                         whileTrue: [ (item ~~ anObject) 
  69.                                        ifTrue: [aBlock value: item].
  70.                        
  71.                                      item <- self next 
  72.                                    ]
  73.                   ]
  74.                   
  75.           ifTrue: [ self do: aBlock ]
  76. |
  77.     error: aString
  78.       <primitive 122 aString self>
  79. |
  80.     isKindOf: aClass ! objectClass !
  81.       objectClass <- self class.
  82.  
  83.       [objectClass notNil] whileTrue:
  84.              [(objectClass == aClass) ifTrue: [^ true].
  85.  
  86.                  objectClass <- objectClass superClass].
  87.       ^ false
  88. |
  89.     isMemberOf: aClass
  90.        ^ aClass == self class
  91. |
  92.     ifKindOf: aClass thenDo: aBlock
  93.        ^ (self isKindOf: aClass) 
  94.             ifTrue: [aBlock value: self]
  95. |
  96.     isNil
  97.        ^ false
  98. |
  99.     next
  100.        ^ nil
  101. |
  102.     notNil
  103.        ^ true
  104. |
  105.     print
  106.        <primitive 121 (self printString)>
  107. |
  108.     printNoReturn
  109.        <primitive 120 (self printString)>
  110. |
  111.     printString
  112.        ^ self asString
  113. |    
  114.     respondsTo: cmd
  115.        ^ self class respondsTo: cmd
  116. |    
  117.     shallowCopy ! size newobj !
  118.        size <- <primitive 4 self>.
  119.  
  120.        (size < 0) 
  121.          ifTrue: [^ self] "if special just copy object"
  122.          ifFalse: [ newobj <- self class new.
  123.  
  124.        (1 to: size) do: [:i |
  125.                <primitive 112 newobj i <primitive 111 self i > > ].
  126.  
  127.                           ^ newobj ]
  128. |
  129.    asciiToString: aNumber ! masked !
  130.       " Convert aNumber into a single-character String: "
  131.  
  132.       masked <- <primitive 23 aNumber 16rFF>.
  133.       
  134.       ^ <primitive 96 masked> 
  135. |
  136.    subclassResponsibility: methodString ! msg !
  137.      msg <- String new: 'Method ',methodString,' should be implemented in a SubClass!'.
  138.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  139. |
  140.    notImplemented: methodString ! msg ! 
  141.      msg <- String new: 'Method ',methodString,' NOT implemented!'.
  142.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  143. |
  144.    doesNotUnderstand: methodString ! msg !
  145.      msg <- String new: 'Method ',methodString,' NOT understood!'.
  146.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'> 
  147. |
  148.    shouldNotImplement: methodString ! msg !
  149.      msg <- String new: 'Method ',methodString,' should NOT BE implemented!'.
  150.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  151. |
  152.    notYetImplemented
  153.      ^ <primitive 181 13 'NOT yet implemented!' 'User ERROR:' 'OKAY'>
  154. |
  155.    perform: selector  ! argArray ! 
  156.    
  157.       " Send the unary selector to the receiver: "
  158.  
  159.       (selector isMemberOf: Symbol)
  160.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  161.  
  162.       (self respondsTo: selector)
  163.          ifFalse: [^ self error: 'Do NOT respondTo:  ', selector ].
  164.  
  165.       argArray <- Array new: 1.
  166.  
  167.       argArray at: 1 put: self.
  168.       
  169.       ^ <primitive 143 argArray selector>
  170. |
  171.    perform: selector orSendTo: otherTarget
  172.    
  173.       " If I wish to intercept and handle selector myself, 
  174.       * do it; else send it to otherTarget
  175.       "
  176.       ^ otherTarget perform: selector
  177. |
  178.    perform: selector with: anObject  ! argArray !
  179.       
  180.       " Send the selector, aSymbol, to the receiver with 
  181.       * anObject as its argument:
  182.       "
  183.       (selector isMemberOf: Symbol)
  184.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  185.  
  186.       (self respondsTo: selector)
  187.          ifFalse: [^ self error: 'Do NOT respondTo:  ', selector ].
  188.  
  189.       argArray <- Array new: 2.
  190.       
  191.       argArray at: 1 put: self.
  192.       argArray at: 2 put: anObject.
  193.       
  194.       ^ <primitive 143 argArray selector>
  195. |
  196.    perform: selector withArguments: argArray ! lsArray !
  197.       
  198.       " Send the selector, aSymbol, to the receiver with 
  199.       * arguments in argArray.  Fail if the number of 
  200.       * arguments expected by the selector does not match 
  201.       * the size of lsArray:
  202.       "
  203.       (argArray size = 0)
  204.          ifTrue: [ ^ self perform: selector ]. " Short-circuit stupid User "
  205.  
  206.       (argArray size = 1)  " Short-circuit stupid User: "
  207.          ifTrue: [ ^ self perform: selector with: (argArray at: 1) ].
  208.          
  209.       " Go the long way around: "
  210.  
  211.       lsArray <- Array new: ((argArray size) + 1).
  212.  
  213.       (selector isMemberOf: Symbol)
  214.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  215.  
  216.       (selector numArgs = argArray size)
  217.          ifFalse: [^ self error: 'Incorrect number of arguments!'].
  218.         
  219.       (self respondsTo: selector)
  220.          ifFalse: [^ self error: 'Do NOT respondTo:  ', selector ].
  221.  
  222.       lsArray at: 1 put: self.
  223.       
  224.       (2 to: lsArray size)
  225.          do: [:ele | lsArray at: ele put: (argArray at: (ele - 1))].
  226.       
  227.       ^ <primitive 143 lsArray selector>
  228. |
  229.    perform: selector with: firstObject with: secondObject ! argArray ! 
  230.  
  231.       " Send the selector, aSymbol, to the receiver with the 
  232.       * given arguments.
  233.       "
  234.       (selector isMemberOf: Symbol)
  235.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  236.  
  237.       (self respondsTo: selector)
  238.          ifFalse: [^ self error: 'Do NOT respondTo:  ', selector ].
  239.  
  240.       argArray <- Array new: 3.
  241.    
  242.       argArray at: 1 put: self.
  243.       argArray at: 2 put: firstObject.
  244.       argArray at: 3 put: secondObject.
  245.  
  246.       ^ <primitive 143 argArray selector>
  247. |
  248.    perform: selector with: firstObject with: secondObject with: thirdObject ! argArray !
  249.    
  250.       " Send the selector, aSymbol, to the receiver with the given arguments: "
  251.  
  252.       (selector isMemberOf: Symbol)
  253.          ifFalse: [^ self error: 'Selector argument must be a Symbol!'].
  254.  
  255.       (self respondsTo: selector)
  256.          ifFalse: [^ self error: 'Do NOT respondTo:  ', selector ].
  257.  
  258.       argArray <- Array new: 4.
  259.  
  260.       argArray at: 1 put: self.
  261.       argArray at: 2 put: firstObject.
  262.       argArray at: 3 put: secondObject.
  263.       argArray at: 4 put: thirdObject.
  264.       
  265.       ^ <primitive 143 argArray selector>
  266. |
  267.    performUpdate: aSymbol with: anObject
  268.       self perform: aSymbol with: anObject
  269. |
  270.    performUpdate: aSymbol
  271.       self perform: aSymbol
  272. |
  273.    breakPoint: msgString
  274.       ^ <primitive 209 10 0 msgString>
  275. ]
  276.